open Ast
;;

open Errors
;;

let cline = ref 0
;;

let line () = !cline
;;

let inc_line () = cline := !cline + 1
;;

let merge_sequences s1 s2 =  match (s1,s2) with
  | (Seq(l1),Seq(l2)) -> Seq(l1@l2)  
  | (_,Seq(l3)) -> Seq(s1::l3)
  | (Seq(l4),_) -> Seq(l4@[s2])
  | (_,_) -> Seq([s1;s2])
;;

let duplicates lst =  
  let rec dupl = function
    | [] -> false 
    | hd::tl -> 
	if (List.mem hd tl) then
	  true
	else
	  dupl tl
  in
dupl (fst(List.split lst)) (* thus not really general purpose... *)
;;

let bsort = function
    Plus -> ((Integer,Integer),Integer)   
  | Minus -> ((Integer,Integer),Integer)
  | Times -> ((Integer,Integer),Integer)
  | Div -> ((Integer,Integer),Integer)
  | Mod -> ((Integer,Integer),Integer)
  | Le -> ((Integer,Integer),Boolean)
  | Leq -> ((Integer,Integer),Boolean)
  | Ge -> ((Integer,Integer),Boolean)
  | Geq -> ((Integer,Integer),Boolean)
  | Eq -> ((Integer,Integer),Boolean)
  | Neq -> ((Integer,Integer),Boolean)
  | And -> ((Boolean,Boolean),Boolean)
  | Or -> ((Boolean,Boolean),Boolean)
;;

let eqsort fs ss = match fs, ss with
  | (Pointer, Pointer) -> Pointer
  | (Record _, Pointer) -> fs
  | (Pointer, Record _) -> ss
  | _ -> if fs = ss then fs
    else raise EType_error

let merge_sort expr sort = match expr with
  | Nil Pointer -> Nil sort
  | _ -> expr

let checked_binexpr op (lexpr, lat) (rexpr, rat) =
  let etype = eqsort lat rat in
    match op, etype with
      | ((Eq | Neq) , (Integer | Record _ | Pointer))
        ->
          let lexpr = merge_sort lexpr etype
          and rexpr = merge_sort rexpr etype in
            (Binexpr (op, lexpr, rexpr), Boolean)
      | _ ->
          let (fts,frt) = bsort op in
            if fts <> (lat, rat) then
              raise EType_error;
            (Binexpr (op, lexpr, rexpr), frt)
;;

let usort = function
    Uminus -> (Integer,Integer)   
  | Neg -> (Boolean,Boolean)
;;

let checked_unexpr op (expr,at) =
  let (ft, frt) = usort op in
    if ft <> at then
      raise EType_error;
    (Unexpr (op,expr), frt)
;;

let checked_field (expr, et) fieldname =
  try match et with
    | Record name -> let fields = Types.fields_sort name in
      let fieldtype = List.assoc fieldname fields in
	(Field (fieldname, expr, name), fieldtype)
    | _ -> raise EType_error;		
  with Not_found -> raise (Unknown_member fieldname); 
;;

